perm filename XR2SU.SAI[PIC,TOB] blob sn#299117 filedate 1977-08-05 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	convert xray format to su format files
C00003 00003	PTR (IO$) IFILE comment input file, channel,etc
C00007 ENDMK
C⊗;
comment convert xray format to su format files;
BEGIN "XRAY TO SU"


REQUIRE "STD[S2,TOB]" SOURCE_FILE;

REQUIRE "IO[S2,TOB]" SOURCE_FILE;

PTR (IO$) IFILE; comment input file, channel,etc;
PTR (IO$) OFILE;  comment output file,channel,etc;
STRING NAME; comment file name;

IFILE←IO$IN(NAME←TTY_STRING(CRLF&"File Name"));
OFILE←IO$OUT("TEST.SU");

  BEGIN "HEADER"
  INTEGER BITS,BYTES;
  INTEGER X1,Y1,X2,Y2;
  INTEGER WDS_LINE,SIZE_FILE;
  INTEGER FIRST_LOC;
  INTEGER I;
  INTEGER PLANE;
  INTEGER OCHAN,ICHAN;

  OCHAN←IO$:CHANNEL[OFILE];
  ICHAN←IO$:CHANNEL[IFILE];

  WORDIN(ICHAN);
  WORDIN(ICHAN);
  BITS←WORDIN(ICHAN);
  WDS_LINE←WORDIN(ICHAN);
  Y1←WORDIN(ICHAN);
  Y2←WORDIN(ICHAN);
  X1←WORDIN(ICHAN);
  X2←WORDIN(ICHAN);
  FIRST_LOC←WORDIN(ICHAN);
  SIZE_FILE←-(FIRST_LOC ASH -18);
  FIRST_LOC←RIGHT_HALF(FIRST_LOC);
  FIRST_LOC←FIRST_LOC+2;
  WORDIN(ICHAN);
  WORDIN(ICHAN);
  WORDIN(ICHAN);
  PLANE←WORDIN(ICHAN);
  WRITE(BITS);WRITE(X1);WRITE(X2);WRITE(Y1);WRITE(Y2);
  PRINT(CRLF);
  WRITE(SIZE_FILE); WRITE(FIRST_LOC);
  
  WORDOUT(OCHAN,-1); comment first word identifier;
  WORDOUT(OCHAN,BITS);comment number of bits;
  WORDOUT(OCHAN,WDS_LINE);
  WORDOUT(OCHAN,Y1);
  WORDOUT(OCHAN,Y2);
  WORDOUT(OCHAN,X1);
  WORDOUT(OCHAN,X2);
  WORDOUT(OCHAN,XWD(-SIZE_FILE,'200));
  FOR I←1 STEP 1 UNTIL 3 DO WORDOUT(OCHAN,0);
  WORDOUT(OCHAN,PLANE);

  FOR I←'14 STEP 1 UNTIL '177 DO WORDOUT(OCHAN,0);
  FOR I←'10 STEP 1 UNTIL FIRST_LOC-1 DO WORDIN(ICHAN);
  FOR I←1 STEP 1 UNTIL SIZE_FILE DO BEGIN "SHIFT"
    INTEGER W;
    W←WORDIN(ICHAN);
    WORDOUT(OCHAN,W LSH 1);
    END "SHIFT";
  CLOSE(OCHAN);
  END "HEADER";
END "XRAY TO SU";